perm filename DPYARC.SAI[1,BGB] blob
sn#001236 filedate 1972-10-22 generic text, type T, neo UTF8
00100 ENTRY FLYCAM;
00200 BEGIN "DPYARC"
00300 DEFINE α="COMMENT", π="3.1415927";
00400 α DISPLAY FUNCTIONS, BUFFER & DPY TEMPORARIES;
00500 REQUIRE "DISPLY[SYS,BGB]" LOAD_MODULE;
00600 EXTERNAL PROCEDURE DPYSET(INTEGER ARRAY DPYBUF);
00700 EXTERNAL PROCEDURE DPYOUT(INTEGER GLASS);
00800 EXTERNAL PROCEDURE HYDPOG(INTEGER GLASS);
00900 EXTERNAL PROCEDURE AIVECT(INTEGER X,Y);
01000 EXTERNAL PROCEDURE AVECT(INTEGER X,Y);
01100 EXTERNAL PROCEDURE RVECT(INTEGER X,Y);
01200 EXTERNAL PROCEDURE DPYSST(STRING S);
01300 EXTERNAL PROCEDURE DPYBIG(INTEGER SIZE);
01400 SAFE INTEGER ARRAY DPYBUF[0:2000];
01500 INTEGER DPYMODE,AERIALMODE,CAMERAMODE,FACTOR,OLDX,OLDY;
01600 α ARC ENDPOINTS A & B ARE RELATIVE TO ARC CENTER AT C,
01700 ARC GOES β DEGREES FROM POINT A COUNTER CLOCKWISE TO B;
01800 SAFE INTEGER ARRAY ARCPDL[1:10,1:7]; α AX,AY,BX,BY,β,AZ,BZ;
01900 α ARC TEMPORARIES, MIDPOINT & MIDARC;
02000 REAL AX,AY,AZ,BX,BY,BZ,CX,CY,CZ,R,RR,β; INTEGER MZ,NZ,MX,MY,NX,NY;
02100 α WORLD MODEL DATA;
02200 EXTERNAL REAL ARRAY LOCII[0:400,1:3];
02300 EXTERNAL INTEGER ARRAY ARCS[1:300,1:3];
02400 EXTERNAL INTEGER ARRAY SEGS[1:300,1:2];
02500 α TIMING RECORD;
02600 INTEGER TIM,INITIM,OLDTIM,DIFTIM,AVG,MAX,MIN,T;
02700 α TRIG FUNCTIONS & TABLES;
02800 REQUIRE "SAITRG[SYS,BGB]" LOAD_MODULE;
02900 EXTERNAL REAL PROCEDURE COS(REAL X);
03000 EXTERNAL REAL PROCEDURE SIN(REAL X);
03100 EXTERNAL REAL PROCEDURE ACOS(REAL X);
03200 EXTERNAL REAL PROCEDURE ATAN2(REAL Y,X);
03300 SAFE REAL ARRAY SINE,COSINE[0:180];
03400 EXTERNAL REAL PROCEDURE SQRT(REAL X);
03500 α CLIPPER SUBROUTINE, ARGS & VALS;
03600 EXTERNAL PROCEDURE CLIP2D;
03700 EXTERNAL INTEGER X1,Y1,X2,Y2,XL,XH,YL,YH,FLAG;
03800 α DRIVER SUBROUTINE & PARAMETERS;
03900 EXTERNAL PROCEDURE COURSE;
04000 EXTERNAL BOOLEAN PROCEDURE DRIVE;
04100 EXTERNAL PROCEDURE INITIAL;
04200 EXTERNAL REAL ARRAY MCL,MVL,EVL,ECL[1:4,1:3];
04300 EXTERNAL REAL PAN,TILT,WHEELS,
04400 AARCX, AARCY, AARCZ,
04500 BARCX, BARCY, BARCZ,
04600 COTX, COTY, COTZ;
04700 α CAMERA FLYER STRENGTHS;
04800 REAL ROTDEL,TRNDEL;
00100 PROCEDURE GETARC (INTEGER I);
00200 BEGIN
00300 INTEGER PTR;
00400 REAL COSINE;
00500 PTR ← ARCS[I,1];
00600 AX ← LOCII[PTR,1];
00700 AY ← LOCII[PTR,2];
00800 AZ ← LOCII[PTR,3];
00900 PTR ← ARCS[I,2];
01000 BX ← LOCII[PTR,1];
01100 BY ← LOCII[PTR,2];
01200 BZ ← LOCII[PTR,3];
01300 PTR ← ARCS[I,3];
01400 CX ← LOCII[PTR,1];
01500 CY ← LOCII[PTR,2];
01600 CZ ← LOCII[PTR,3];
01700 AX ← AX - CX;
01800 AY ← AY - CY;
01900 BX ← BX - CX;
02000 BY ← BY - CY;
02100 RR ← (AX↑2 + AY↑2 + BX↑2 + BY↑2)/2;
02200 R ← SQRT(RR);
02300 COSINE ← (AX*BX + AY*BY) /(SQRT(AX↑2 + AY↑2)*SQRT(BX↑2 + BY↑2));
02400 β ← 180*ACOS(COSINE)/π;
02500 IF AX*BY < BX*AY THEN
02600 BEGIN
02700 AX ↔ BX;
02800 AY ↔ BY;
02900 AZ ↔ BZ;
03000 END;
03100 END;
00100 PROCEDURE DPYLAB (REAL X,Y,Z; STRING S);
00200 BEGIN
00300 REAL XX,YY,ZZ;
00400 X ← X - ECL[4,1];
00500 Y ← Y - ECL[4,2];
00600 Z ← Z - ECL[4,3];
00700 XX ← X*ECL[1,1] + Y*ECL[1,2] + Z*ECL[1,3];
00800 YY ← X*ECL[2,1] + Y*ECL[2,2] + Z*ECL[2,3];
00900 ZZ ← X*ECL[3,1] + Y*ECL[3,2] + Z*ECL[3,3];
01000 IF ZZ>-(0.25/12) THEN RETURN;
01100 XX ← -(XX/ZZ)*2↑10 - 14;
01200 YY ← -(YY/ZZ)*2↑10 - 6;
01300 IF YY<YL ∨ YY>YH ∨ XX<XL ∨ XX>XH THEN RETURN;
01400 AIVECT(XX,YY);
01500 DPYSST(S);
01600 END;
01700
01800 INTERNAL PROCEDURE DPYV;
01900 BEGIN
02000 INTEGER I;
02100 DPYSET(DPYBUF);
02200 DPYBIG(1);
02300 FOR I←0 STEP 1 UNTIL 195 DO
02400 DPYLAB(LOCII[I,1],LOCII[I,2],LOCII[I,3],"* V"&CVS(I));
02500 DPYBIG(2);
02600 DPYOUT(5);
02700 END;
00100 PROCEDURE CAMERADPY;
00200 BEGIN "CAMERA DPY"
00300 INTEGER I,J;
00400 REAL CIX,CIY,CIZ, TX1,TY1,TZ1,TX2,TY2,TZ2,
00500 CJX,CJY,CJZ, RX1,RY1,RZ1,RX2,RY2,RZ2,
00600 CKX,CKY,CKZ, DELNEW,DELTAZ,
00700 CCX,CCY,CCZ, MX,MY,MZ,F,Q1,Q2, NX,NY,NZ,
00800 DXM,DYM,DZM, DXN,DYN,DZN, RESOLVE,
00900 RRM,RRN,PHI;
01000 SAFE REAL ARRAY ARCPDL[1:10,1:7];
01100
00100 α 3D - LINE SEGMENT DISPLAY SUBROUTINE;
00200
00300 PROCEDURE LSD3D (REAL XX1,YY1,ZZ1,XX2,YY2,ZZ2);
00400 BEGIN "LSD-3D"
00500 TX1 ← XX1 - CCX; α TRANSLATION;
00600 TY1 ← YY1 - CCY;
00700 TZ1 ← ZZ1 - CCZ;
00800 TX2 ← XX2 - CCX;
00900 TY2 ← YY2 - CCY;
01000 TZ2 ← ZZ2 - CCZ;
01100 RX1 ← TX1*CIX + TY1*CIY + TZ1*CIZ; α ROTATION;
01200 RY1 ← TX1*CJX + TY1*CJY + TZ1*CJZ;
01300 RZ1 ← TX1*CKX + TY1*CKY + TZ1*CKZ;
01400 RX2 ← TX2*CIX + TY2*CIY + TZ2*CIZ;
01500 RY2 ← TX2*CJX + TY2*CJY + TZ2*CJZ;
01600 RZ2 ← TX2*CKX + TY2*CKY + TZ2*CKZ;
01700 IF RZ1 < -F ∨ RZ2 < -F THEN α IN FRONT OF CAMERA PLANE TEST;
01800 BEGIN "INVIEW"
01900 IF RZ2 < -F THEN α FORCE POINT-1 INVIEW;
02000 BEGIN "SWAP"
02100 RX1 ↔ RX2;
02200 RY1 ↔ RY2;
02300 RZ1 ↔ RZ2;
02400 END "SWAP";
02500 IF RZ2 > -F THEN α 3D-CLIPPING;
02600 BEGIN "3D-CLIP"
02700 DELTAZ ← RZ2 - RZ1;
02800 RZ2 ← -F;
02900 DELNEW ← RZ2 - RZ1;
03000 RX2 ← DELNEW * (RX2 - RX1) / DELTAZ + RX1;
03100 RY2 ← DELNEW * (RY2 - RY1) / DELTAZ + RY1;
03200 END "3D-CLIP";
03300
03400 α PERSPECTIVE PROJECTION AND SCALING PHYSICAL TO LOGICAL;
03500 X1 ← -(RX1/RZ1) * 2↑10;
03600 Y1 ← -(RY1/RZ1) * 2↑10;
03700 X2 ← -(RX2/RZ2) * 2↑10;
03800 Y2 ← -(RY2/RZ2) * 2↑10;
03900 α YE OLDE 2D-CLIPPER;
04000 CLIP2D;
04100 IF FLAG THEN
04200 BEGIN
04300 AIVECT(X1,Y1);
04400 AVECT(X2,Y2) ;
04500 END;
04600 END "INVIEW";
04700 END "LSD-3D";
00200 α CAMERA DPY CONTINUED - INITIALIZATION & SEGMENT DPY;
00300 DPYSET(DPYBUF);
00400 F ← 0.25/12; α THE FOCAL LENGTH IN FEET;
00500 RESOLVE ← COS(20/1000)↑2; α DISPLAY RESOLUTION - MAJOR QUANTUM PER CAMERA ANGLE;
00600 CIX←ECL[1,1]; CIY←ECL[1,2]; CIZ←ECL[1,3];
00700 CJX←ECL[2,1]; CJY←ECL[2,2]; CJZ←ECL[2,3];
00800 CKX←ECL[3,1]; CKY←ECL[3,2]; CKZ←ECL[3,3];
00900 CCX←ECL[4,1]; CCY←ECL[4,2]; CCZ←ECL[4,3];
01000
01100 FOR I←1 STEP 1 UNTIL 82 DO
01200 BEGIN
01300 INTEGER END1,END2;
01400 REAL X1,Y1,Z1,X2,Y2,Z2;
01500 END1 ← SEGS[I,1];
01600 END2 ← SEGS[I,2];
01700 X1 ← LOCII[END1,1]; X2 ← LOCII[END2,1];
01800 Y1 ← LOCII[END1,2]; Y2 ← LOCII[END2,2];
01900 Z1 ← LOCII[END1,3]; Z2 ← LOCII[END2,3];
02000 LSD3D(X1,Y1,Z1,X2,Y2,Z2);
02100 END;
00100 α CAMERA DPY CONTINUED - ARC DISPLAY;
00200 FOR I←1 STEP 1 UNTIL 98 DO
00300 BEGIN "ARC DPY"
00400 GETARC(I);
00500 TX1 ← CX - CCX;
00600 TY1 ← CY - CCY;
00700 TZ1 ← CZ - CCZ;
00800 RZ1 ← TX1*CKX + TY1*CKY + TZ1*CKZ;
00900 α IS THE ARC'S CENTER WITHIN A RADIUS OF THE CAMERA'S BACKSIDE ?;
01000 IF RZ1 < R - F THEN
01100 BEGIN "ARC L-LOOP"
01200 LABEL L;
01300 β ← β * 3.14/180;
01400 α MIDPOINT;
01500 L: MX ← (AX + BX)/2;
01600 MY ← (AY + BY)/2;
01700 MZ ← (AZ + BZ)/2;
01800 α MIDARC;
01900 β ← β/2;
02000 NX ← ((AX+BX)*COS(β) - (AY-BY)*SIN(β))/2;
02100 NY ← ((AX-BX)*SIN(β) + (AY+BY)*COS(β))/2;
02200 NZ ← MZ;
02300 α ARE WE DOWN TO THE RESOLUTION OF THE DISPLAY ?;
02400 DXM ← (CX + MX - CCX);
02500 DYM ← (CY + MY - CCY);
02600 DZM ← MZ - CCZ;
02700 RRM ← SQRT( DXM↑2 + DYM↑2 + DZM↑2);
02800 DXN ← (CX + NX - CCX);
02900 DYN ← (CY + NY - CCY);
03000 DZN ← NZ - CCZ;
03100 RRN ← SQRT( DXN↑2 + DYN↑2 + DZN↑2);
03200 Q1 ← DXM*DXN + DYM*DYN + DZM*DZN;
03300 PHI ← ACOS( Q1/(RRM*RRN));
03400 IF 10>5000*PHI ∨ J=9 ∨ (β<0.02) THEN
03500 LSD3D(CX + AX,CY + AY,AZ,CX + BX,CY + BY,BZ) ELSE
00100 α CAMERA DPY CONTINUED;
00200 BEGIN "ARC PUSHER"
00300 J ← J+1; α PUSH 'EM DOWN;
00400 IF J=10 THEN OUTSTR("ARCPDL OVER J=10 !"&13&10);
00500 ARCPDL[J,3] ← BX;
00600 ARCPDL[J,4] ← BY;
00700 ARCPDL[J,7] ← BZ;
00800 BX ← ARCPDL[J,1] ← NX;
00900 BY ← ARCPDL[J,2] ← NY;
01000 BZ ← ARCPDL[J,6] ← NZ;
01100 ARCPDL[J,5] ← β;
01200 GO L;
01300 END "ARC PUSHER";
01400 IF J≠0 THEN
01500 BEGIN "POPPER"
01600 AX ← ARCPDL[J,1];
01700 AY ← ARCPDL[J,2];
01800 AZ ← ARCPDL[J,6];
01900 BX ← ARCPDL[J,3];
02000 BY ← ARCPDL[J,4];
02100 BZ ← ARCPDL[J,7];
02200 β ← ARCPDL[J,5];
02300 J ← J-1;
02400 GO L;
02500 END "POPPER";
02600 END "ARC L-LOOP";
02700 END "ARC DPY";
00100 α TIMING AND DISPLAY;
00200 OLDTIM←TIM;
00300 TIM ← CALL(0,"RUNTIM");
00400 T←T+1;
00500 AVG ← (TIM-INITIM)/T;
00600 DIFTIM←TIM-OLDTIM;
00700 IF DIFTIM>MAX THEN MAX←DIFTIM;
00800 IF DIFTIM<MIN THEN MIN←DIFTIM;
00900 AIVECT(-480,-465);
01000 DPYSST("MAX = "&CVS(MAX));
01100 DPYSST(" MIN = "&CVS(MIN));
01200 DPYSST(" AVG = "&CVS(AVG));
01300 DPYSST(" NOW = "&CVS(DIFTIM));
01400 DPYOUT(1);
01500 END "CAMERA DPY";
01600
00100 α ECL & ROT/DEL PARAMETERS DISPLAYED IN UPPER LEFT HAND CORNER;
00200 PROCEDURE ECLDPY;
00300 BEGIN
00400 REAL PAN,TILT,SWING;
00500 INTEGER ARRAY DPYBUF[1:100];
00600 DPYSET(DPYBUF);
00700 DPYBIG(1);
00800 SETFORMAT(0,3);
00900 AIVECT(200,-440);DPYSST("X");
01000 AIVECT(275,-440);DPYSST("Y");
01100 AIVECT(350,-440);DPYSST("Z");
01200 AIVECT(425,-440);DPYSST("TRNDEL");
01300 AIVECT(200,-480);DPYSST("i-PAN");
01400 AIVECT(275,-480);DPYSST("k-TILT");
01500 AIVECT(350,-480);DPYSST("i-SWING");
01600 AIVECT(425,-480);DPYSST("ROTDEL");
01700 DEFINE IX="ECL[1,1]",IY="ECL[1,2]",IZ="ECL[1,3]",KX="ECL[3,1]",KY="ECL[3,2]",KZ="ECL[3,3]";
01800 PAN ← ATAN2(IY,IX)*180/π;
01900 TILT ← ATAN2(SQRT(KX↑2+KY↑2),KZ)*180/π;
02000 SWING ← ATAN2(IZ,SQRT(IX↑2+IY↑2))*180/π;
02100 AIVECT(200,-460);DPYSST(CVG(ECL[4,1]));
02200 AIVECT(275,-460);DPYSST(CVG(ECL[4,2]));
02300 AIVECT(350,-460);DPYSST(CVG(ECL[4,3]));
02400 AIVECT(425,-460);DPYSST(CVG(TRNDEL));
02500 AIVECT(200,-500);DPYSST(CVG(PAN));
02600 AIVECT(275,-500);DPYSST(CVG(TILT));
02700 AIVECT(350,-500);DPYSST(CVG(SWING));
02800 AIVECT(425,-500);DPYSST(CVG(ROTDEL*180/π));
02900 DPYBIG(2);
03000 DPYOUT(2);
03100 SETFORMAT(0,7);
03200 END;
00100 PROCEDURE RESET;
00200 BEGIN "RESET"
00300 INTEGER I;
00400 EVL[1,1]←0;ARRBLT(EVL[1,2],EVL[1,1],12);TILT←-3.14/2;
00500 EVL[1,1]←EVL[2,2]←EVL[3,3]←1;
00600 ECL[1,1]←ECL[2,2]←ECL[3,3]←1;
00700 ECL[4,1] ← 0;
00800 ECL[4,2] ← 250;
00900 ECL[4,3] ← 1000;
01000 XL←YL← -511;
01100 XH←YH← 511;
01200 DPYSET(DPYBUF);
01300 AIVECT(XL,YL);AVECT(XL,YH);AVECT(XH,YH);AVECT(XH,YL);AVECT(XL,YL);DPYOUT(0);
01400 MAX←0;MIN←999999;TIM←INITIM←CALL(0,"RUNTIM");
01500 TRNDEL ← 40;
01600 ROTDEL ← π/8;
01700 CAMERADPY;
01800 END "RESET";
00100 INTERNAL PROCEDURE FLYCAM;
00200 α THIS IS THE UNIDENTIFIED FLYING CAMERA SUB-COMMAND LISTEN LOOP;
00300 WHILE TRUE DO
00400 BEGIN
00500 INTEGER CHR,CTRL1,CTRL2,AXIS,SIGN;
00600 INTEGER I,J;
00700 LABEL L1,EOL;
00800 ECLDPY;
00900 CHR ← INCHRW;
01000 IF CHR='175 THEN RETURN;
01100 IF CHR="R" THEN BEGIN RESET;GO EOL END;
01200 α ESCAPE KEY - ALT MODE;
01300 IF CHR = '175 THEN DONE;
01400 α CONTROL KEYS;
01500 CTRL1 ← CHR LAND '200;
01600 CTRL2 ← CHR LAND '400;
01700 CHR ← CHR LAND '177;
01800 α POSITIVE DIRECTION KEYS;
01900 SIGN ← +1;
02000 AXIS ←
02100 IF CHR="]" THEN 0 ELSE
02200 IF CHR=">" THEN 1 ELSE
02300 IF CHR="∧" THEN 2 ELSE
02400 IF CHR="⊃" THEN 3 ELSE 4;
02500 IF AXIS≠4 THEN GO L1;
02600 α NEGATIVE DIRECTION KEYS;
02700 SIGN ← -1;
02800 AXIS ←
02900 IF CHR="[" THEN 0 ELSE
03000 IF CHR="<" THEN 1 ELSE
03100 IF CHR="∨" THEN 2 ELSE
03200 IF CHR="¬" THEN 3 ELSE 4;
03300 IF AXIS=4 THEN GO EOL;
03400
03500 α DOUBLE OR HALVE THE ROTATION - TRANSLATION STRENGTHS AS REQUIRED;
03600 L1: IF AXIS=0 THEN
03700 BEGIN
03800 IF SIGN>0 THEN
03900 IF CTRL1 THEN ROTDEL ← 2 * ROTDEL
04000 ELSE TRNDEL ← 2 * TRNDEL ELSE
04100 IF CTRL1 THEN ROTDEL ← ROTDEL/2
04200 ELSE TRNDEL ← TRNDEL/2;
04300 GO EOL;
04400 END;
00100 α WORLD FRAME TRANSLATION - NO CTRL KEYS;
00200 IF CTRL1=0 THEN IF CTRL2=0 THEN
00300 ECL[4,AXIS] ← ECL[4,AXIS] + SIGN*TRNDEL ELSE
00400
00500 α CAMERA FRAME TRANSLATION - CTRL2 ONLY;
00600 FOR I←1 STEP 1 UNTIL 3 DO
00700 ECL[4,I] ← ECL[4,I] + SIGN*TRNDEL*ECL[AXIS,I] ELSE
00800
00900 α ROTATIONS;
01000 BEGIN
01100 REAL ARRAY A,B[1:3,1:3];
01200 REAL C,S;
01300 C ← COS(ROTDEL);
01400 S ← SIGN*SIN(ROTDEL);
01500 ARRBLT(B[1,1],ECL[1,1],9);
01600 A[1,1] ← 0;
01700 ARRBLT(A[1,2],A[1,1],8);
01800 A[1,1] ← A[2,2] ← A[3,3] ←C;
01900 A[AXIS,AXIS] ← 1;
02000 I ← IF AXIS=1 THEN 2 ELSE 1;
02100 J ← IF AXIS=3 THEN 2 ELSE 3;
02200 IF AXIS=2 THEN I↔J;
02300 A[I,J] ← S;
02400 A[J,I] ← -S;
02500 α CTRL1 ONLY - ROTATION ABOUT CAMERA'S AXIS;
02600 IF CTRL2=0 THEN
02700 FOR I ← 1 STEP 1 UNTIL 3 DO
02800 FOR J ← 1 STEP 1 UNTIL 3 DO
02900 ECL[I,J] ← A[I,1]*B[1,J] + A[I,2]*B[2,J] + A[I,3]*B[3,J] ELSE
03000 FOR I ← 1 STEP 1 UNTIL 3 DO
03100 FOR J ← 1 STEP 1 UNTIL 3 DO
03200 ECL[I,J] ← B[I,1]*A[1,J] + B[I,2]*A[2,J] + B[I,3]*A[3,J];
03300 END;
03400 CAMERADPY;
03500 EOL: α END OF LOOP LABEL;
03600 END;
03700 END